home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / clipper / s93bsp.exe / BODY00.PRG < prev    next >
Encoding:
Text File  |  1993-10-15  |  4.1 KB  |  186 lines
  1. if pcount()<>0
  2.     altd()
  3. endif
  4. do bodywork
  5. * set procedure to CUSTYPFN additive
  6. * set procedure to HOUSE00 additive
  7. * set procedure to INV00 additive
  8. * set procedure to INV01 additive
  9. * set procedure to INVSCRN additive
  10. * set procedure to INVSLCT additive
  11. * set procedure to PARTFUNC additive
  12. * set procedure to QBDBFUNC additive
  13. * set procedure to QBIPROC additive
  14. * set procedure to QBPROCS additive
  15. * set procedure to QBTXTMAC additive
  16. * set procedure to REP00 additive
  17. quit
  18.  
  19. function gotop
  20. go top
  21. return reccount()
  22.  
  23. function qbskip
  24. parameters nSkip
  25. skip nSkip
  26. return recno()
  27.  
  28.  
  29. procedure BODYWORK
  30. *** BODY00.PRG : Main menu.
  31. ***
  32.  
  33. do QBINIT
  34. do BODYINIT
  35.  
  36. private MAINCH
  37.  
  38. do while .t.
  39.  
  40.     do QBLAYOUT with "Main menu"
  41.     do QBBOX with 40
  42.     MAINCH = QBMENU("MAIN",30)
  43.  
  44.     do case
  45.     case MAINCH=0 .or. MAINCH=4
  46.         if QBYESNO("Do you really wish to Quit now?")="Y"
  47.             exit
  48.         endif
  49.     case MAINCH=1
  50.         do INVMAIN
  51.     case MAINCH=2
  52.          do REPMAIN
  53.     case MAINCH=3
  54.          do HOUSEMAIN
  55.     endcase
  56.     QBCHOICE = MAINCH
  57.  
  58. enddo
  59.  
  60. close database
  61. clear
  62. ?? "Exit "+trim(QBTITLE)+" application"
  63. quit
  64.  
  65. *******************************************************************
  66.  
  67. procedure BODYINIT
  68. *       B O D Y I N I T
  69.  
  70. *       INVOICE Information
  71.  
  72. public MINVNO, MSPEEDO, MFUEL, MPARTDISC, MVATRATE, MOWNNAME, MOWNADD1
  73. public MOWNADD2, MOWNADD3, MMAKEMODEL, MINSCO, MINSADD1, MINSADD2, MINSENG
  74. public MINSTEL, MPAINT, MOWNTELH, MOWNTELB, MOWNVAT, MINSTOPAY, MACTYPE
  75. public MWORKTYPE, MDATEIN, MDATEOUT, MDATEINV, MREGNO, MYEAR, MENGNO
  76. public MCHASNO, MESTNO, MLABESTNO, MCLAIMNO, MLABOUR1, MLABOUR2, MLABOUR3
  77. public MLABOUR4, MLABOURT, MINSLAB, MOWNLAB, MINSPART, MOWNPART, MINSSPEC
  78. public MOWNSPEC, MINSAMT, MOWNAMT, MEXCESS, MCONTRIB, MINSDUE, MOWNDUE
  79. public MINVTOTAL, MCUSTTYP, ML2TEXT, ML3TEXT, ML4TEXT, MTRIM
  80. public MPARTSPEC, MPARTDESC, MQTY, MTPRICE, MUPRICE, MOWNINIT
  81. public IPDSCNT, OPDSCNT, ISUBTOT, OSUBTOT, IVATAMT, OVATAMT, INSSUB, OWNSUB
  82. public MCTYPE, MCDESC, MADD, MPLINENO, MEDITING, AUTOADD
  83. * public PARTFLDS[5], PARTHDRS[5], PARTPICS[5]
  84. public PARTFLDS[4], PARTHDRS[4], PARTPICS[4]
  85.  
  86. INVCLEAR()
  87. PARTCLEAR()
  88. store space(4) to MCUSTTYP
  89. store space(35) to MCDESC
  90. store .f. to MADD, MEDITING, AUTOADD
  91.  
  92. PARTHDRS[1] = " Description"
  93. PARTFLDS[1] = "PARTDESC"
  94. PARTPICS[1] = replicate("X",15)
  95. PARTHDRS[2] = "Qty"
  96. PARTFLDS[2] = "QTY"
  97. PARTPICS[2] = "99"
  98. PARTHDRS[3] = " Unit P"
  99. PARTFLDS[3] = "UPRICE"
  100. PARTPICS[3] = "9999.99"
  101. PARTHDRS[4] = "Total P"
  102. PARTFLDS[4] = "TPRICE"
  103. PARTPICS[4] = "9999.99"
  104. *PARTHDRS[5] = "Part/Spec"
  105. *PARTFLDS[5] = "PARTSPEC"
  106. *PARTPICS[5] = "@R     !"
  107.  
  108. return
  109.  
  110. *******************************************************************
  111.  
  112. function V2DATES
  113. *       Vali DATE ha ha
  114. parameters otherd, TESTYPE
  115. private RETVAL, MEM, VARNAME
  116.  
  117. VARNAME = readvar()
  118. MEM = &VARNAME
  119. if (empty(MEM) .or. empty(OTHERD)) .and. TESTYPE>0
  120.     return .t.
  121. else
  122.     TESTYPE = abs(TESTYPE)
  123. endif
  124.  
  125. do case
  126. case TESTYPE=1
  127.     RETVAL = (MEM<=OTHERD)
  128. case TESTYPE=2
  129.     RETVAL = (MEM>=OTHERD)
  130. case TESTYPE=3
  131.     RETVAL = (MEM<OTHERD)
  132. case TESTYPE=4
  133.     RETVAL = (MEM>OTHERD)
  134. otherwise
  135.     RETVAL = .t.
  136. endcase
  137.  
  138. return RETVAL
  139.  
  140. *****************************************************************
  141.  
  142. function PRPOS
  143. parameters NUM, PIC
  144. private PLEN, RETVAL
  145.  
  146. if NUM>0
  147.     RETVAL = transform(NUM,PIC)
  148. else
  149.     RETVAL = space(len(PIC))
  150. *    RETVAL = replicate("#",len(PIC))
  151. endif
  152.  
  153. return RETVAL
  154.  
  155. **************************************************************
  156.  
  157. function NEWNUM
  158. *       Validate New Invoice number
  159. parameters PRMSG
  160. if pcount()=0
  161.     PRMSG = .f.
  162. endif
  163. private SELNO, RETVAL, OLDSCR, MEM, VARNAME
  164.  
  165. if PRMSG
  166.     VARNAME = readvar()
  167.     MEM = &VARNAME
  168. else
  169.     MEM = MINVNO
  170. endif
  171. SELNO = select()
  172.  
  173. select INVOICE
  174. set index to INVNUM
  175. set softseek off
  176. seek str(MEM,5)
  177. RETVAL = eof() .and. MEM>0
  178. if (.not. RETVAL) .and. PRMSG
  179.     OLDSCR = savescreen(0,0,1,79)
  180.     do QBMESS with "Invoice already exists",colflash,3
  181.     restscreen(0,0,1,79,OLDSCR)
  182. endif
  183. select (SELNO)
  184.  
  185. return RETVAL
  186.